home *** CD-ROM | disk | FTP | other *** search
/ PC Open 101 / PC Open 101 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / Proxy / SMTP.pm < prev   
Encoding:
Perl POD Document  |  2004-08-06  |  13.9 KB  |  416 lines
  1. # POPFILE LOADABLE MODULE
  2. package Proxy::SMTP;
  3.  
  4. use Proxy::Proxy;
  5. @ISA = ("Proxy::Proxy");
  6.  
  7. # ---------------------------------------------------------------------------------------------
  8. #
  9. # This module handles proxying the SMTP protocol for POPFile.
  10. #
  11. # Copyright (c) 2001-2004 John Graham-Cumming
  12. #
  13. #   This file is part of POPFile
  14. #
  15. #   POPFile is free software; you can redistribute it and/or modify
  16. #   it under the terms of the GNU General Public License as published by
  17. #   the Free Software Foundation; either version 2 of the License, or
  18. #   (at your option) any later version.
  19. #
  20. #   POPFile is distributed in the hope that it will be useful,
  21. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. #   GNU General Public License for more details.
  24. #
  25. #   You should have received a copy of the GNU General Public License
  26. #   along with POPFile; if not, write to the Free Software
  27. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  28. #
  29. # ---------------------------------------------------------------------------------------------
  30.  
  31. use strict;
  32. use warnings;
  33. use locale;
  34.  
  35. # A handy variable containing the value of an EOL for networks
  36. my $eol = "\015\012";
  37.  
  38. #----------------------------------------------------------------------------
  39. # new
  40. #
  41. #   Class new() function
  42. #----------------------------------------------------------------------------
  43. sub new
  44. {
  45.     my $type = shift;
  46.     my $self = Proxy::Proxy->new();
  47.  
  48.     # Must call bless before attempting to call any methods
  49.  
  50.     bless $self, $type;
  51.  
  52.     $self->name( 'smtp' );
  53.  
  54.     $self->{child_} = \&child__;
  55.     $self->{connection_timeout_error_} = '554 Transaction failed';
  56.     $self->{connection_failed_error_}  = '554 Transaction failed, can\'t connect to';
  57.     $self->{good_response_}            = '^[23]';
  58.  
  59.     return $self;
  60. }
  61.  
  62. # ---------------------------------------------------------------------------------------------
  63. #
  64. # initialize
  65. #
  66. # Called to initialize the SMTP proxy module
  67. #
  68. # ---------------------------------------------------------------------------------------------
  69. sub initialize
  70. {
  71.     my ( $self ) = @_;
  72.  
  73.     # By default we don't fork on Windows
  74.     $self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
  75.  
  76.     # Default port for SMTP service
  77.     $self->config_( 'port', 25 );
  78.  
  79.     # Where to forward on to
  80.     $self->config_( 'chain_server', '' );
  81.     $self->config_( 'chain_port', 25 );
  82.  
  83.     # Only accept connections from the local machine for smtp
  84.     $self->config_( 'local', 1 );
  85.  
  86.     # The welcome string from the proxy is configurable
  87.     $self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" );
  88.  
  89.     if ( !$self->SUPER::initialize() ) {
  90.         return 0;
  91.     }
  92.  
  93.     $self->config_( 'enabled', 0 );
  94.  
  95.     return 1;
  96. }
  97.  
  98. # ---------------------------------------------------------------------------------------------
  99. #
  100. # start
  101. #
  102. # Called to start the SMTP proxy module
  103. #
  104. # ---------------------------------------------------------------------------------------------
  105. sub start
  106. {
  107.     my ( $self ) = @_;
  108.  
  109.     # If we are not enabled then no further work happens in this module
  110.  
  111.     if ( $self->config_( 'enabled' ) == 0 ) {
  112.         return 2;
  113.     }
  114.  
  115.     # Tell the user interface module that we having a configuration
  116.     # item that needs a UI component
  117.  
  118.     $self->register_configuration_item_( 'configuration',
  119.                                          'smtp_fork_and_port',
  120.                                          'smtp-configuration.thtml',
  121.                                          $self );
  122.  
  123.     $self->register_configuration_item_( 'security',
  124.                                          'smtp_local',
  125.                                          'smtp-security-local.thtml',
  126.                                          $self );
  127.  
  128.     $self->register_configuration_item_( 'chain',
  129.                                          'smtp_server',
  130.                                          'smtp-chain-server.thtml',
  131.                                          $self );
  132.  
  133.     $self->register_configuration_item_( 'chain',
  134.                                          'smtp_server_port',
  135.                                          'smtp-chain-server-port.thtml',
  136.                                          $self );
  137.  
  138.     return $self->SUPER::start();;
  139. }
  140.  
  141. # ---------------------------------------------------------------------------------------------
  142. #
  143. # child__
  144. #
  145. # The worker method that is called when we get a good connection from a client
  146. #
  147. # $client   - an open stream to a SMTP client
  148. # $session        - API session key
  149. #
  150. # ---------------------------------------------------------------------------------------------
  151. sub child__
  152. {
  153.     my ( $self, $client, $session ) = @_;
  154.  
  155.     # Number of messages downloaded in this session
  156.     my $count = 0;
  157.  
  158.     # The handle to the real mail server gets stored here
  159.     my $mail;
  160.  
  161.     # Tell the client that we are ready for commands and identify our version number
  162.     $self->tee_( $client, "220 " . $self->config_( 'welcome_string' ) . "$eol" );
  163.  
  164.     # Retrieve commands from the client and process them until the client disconnects or
  165.     # we get a specific QUIT command
  166.     while  ( <$client> ) {
  167.         my $command;
  168.  
  169.         $command = $_;
  170.  
  171.         # Clean up the command so that it has a nice clean $eol at the end
  172.         $command =~ s/(\015|\012)//g;
  173.  
  174.         $self->log_( 2, "Command: --$command--" );
  175.  
  176.         if ( $command =~ /HELO/i ) {
  177.             if ( $self->config_( 'chain_server' ) )  {
  178.                 if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ),  $self->config_( 'chain_port' ) ) )  {
  179.  
  180.                     $self->smtp_echo_response_( $mail, $client, $command );
  181.                 } else {
  182.                     last;
  183.                 }
  184.             } else {
  185.                 $self->tee_(  $client, "421 service not available$eol" );
  186.             }
  187.  
  188.             next;
  189.         }
  190.  
  191.         # Handle EHLO specially so we can control what ESMTP extensions are negotiated
  192.  
  193.         if ( $command =~ /EHLO/i ) {
  194.             if ( $self->config_( 'chain_server' ) )  {
  195.                 if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ),  $self->config_( 'chain_port' ) ) )  {
  196.  
  197.                     # TODO: Make this user-configurable (-smtp_add_unsupported, -smtp_remove_unsupported)
  198.  
  199.                     # Stores a list of unsupported ESMTP extensions
  200.  
  201.                     my $unsupported;
  202.  
  203.                     # RFC 1830, http://www.faqs.org/rfcs/rfc1830.html
  204.                     # CHUNKING and BINARYMIME both require the support of the "BDAT" command
  205.                     # support of BDAT requires extensive changes to POPFile's internals and
  206.                     # will not be implemented at this time
  207.  
  208.                     $unsupported .= "CHUNKING|BINARYMIME";
  209.  
  210.                     # append unsupported ESMTP extensions to $unsupported here, important to maintain
  211.                     # format of OPTION|OPTION2|OPTION3
  212.  
  213.                     $unsupported = qr/250\-$unsupported/;
  214.  
  215.                     $self->smtp_echo_response_( $mail, $client, $command, $unsupported );
  216.  
  217.  
  218.                 } else {
  219.                     last;
  220.                 }
  221.             } else {
  222.                 $self->tee_(  $client, "421 service not available$eol" );
  223.             }
  224.  
  225.             next;
  226.         }
  227.  
  228.         if ( ( $command =~ /MAIL FROM:/i )    ||
  229.              ( $command =~ /RCPT TO:/i )      ||
  230.              ( $command =~ /VRFY/i )          ||
  231.              ( $command =~ /EXPN/i )          ||
  232.              ( $command =~ /NOOP/i )          ||
  233.              ( $command =~ /HELP/i )          ||
  234.              ( $command =~ /RSET/i ) ) {
  235.             $self->smtp_echo_response_( $mail, $client, $command );
  236.             next;
  237.         }
  238.  
  239.         if ( $command =~ /DATA/i ) {
  240.             # Get the message from the remote server, if there's an error then we're done, but if not then
  241.             # we echo each line of the message until we hit the . at the end
  242.             if ( $self->smtp_echo_response_( $mail, $client, $command ) ) {
  243.                 $count += 1;
  244.  
  245.                 my ( $class, $history_file ) = $self->{classifier__}->classify_and_modify( $session, $client, $mail, 0, '', 0  );
  246.  
  247.                 my $response = $self->slurp_( $mail );
  248.                 $self->tee_( $client, $response );
  249.                 next;
  250.             }
  251.         }
  252.  
  253.         # The mail client wants to stop using the server, so send that message through to the
  254.         # real mail server, echo the response back up to the client and exit the while.  We will
  255.         # close the connection immediately
  256.         if ( $command =~ /QUIT/i ) {
  257.             if ( $mail )  {
  258.                 $self->smtp_echo_response_( $mail, $client, $command );
  259.                 close $mail;
  260.             } else {
  261.                 $self->tee_(  $client, "221 goodbye$eol" );
  262.             }
  263.             last;
  264.         }
  265.  
  266.         # Don't know what this is so let's just pass it through and hope for the best
  267.         if ( $mail && $mail->connected )  {
  268.             $self->smtp_echo_response_( $mail, $client, $command );
  269.             next;
  270.         } else {
  271.             $self->tee_(  $client, "500 unknown command or bad syntax$eol" );
  272.             last;
  273.         }
  274.     }
  275.  
  276.     if ( defined( $mail ) ) {
  277.         $self->done_slurp_( $mail );
  278.         close $mail;
  279.     }
  280.  
  281.     close $client;
  282.     $self->mq_post_( 'CMPLT', $$ );
  283.     $self->log_( 0, "SMTP proxy done" );
  284. }
  285.  
  286. # ---------------------------------------------------------------------------------------------
  287. #
  288. # smtp_echo_response_
  289. #
  290. # $mail     The stream (created with IO::) to send the message to (the remote mail server)
  291. # $client   The local mail client (created with IO::) that needs the response
  292. # $command  The text of the command to send (we add an EOL)
  293. # $suppress (OPTIONAL) suppress any lines that match, compile using qr/pattern/
  294. #
  295. # Send $command to $mail, receives the response and echoes it to the $client and the debug
  296. # output.
  297. #
  298. # This subroutine returns responses from the server as defined in appendix E of
  299. # RFC 821, allowing multi-line SMTP responses.
  300. #
  301. # Returns true if the initial response is a 2xx or 3xx series (as defined by {good_response_}
  302. #
  303. # ---------------------------------------------------------------------------------------------
  304. sub smtp_echo_response_
  305. {
  306.     my ($self, $mail, $client, $command, $suppress) = @_;
  307.     my ( $response, $ok ) = $self->get_response_( $mail, $client, $command );
  308.  
  309.     if ( $response =~ /^\d\d\d-/ ) {
  310.         $self->echo_to_regexp_($mail, $client, qr/^\d\d\d /, 1, $suppress);
  311.     }
  312.     return ( $response =~ /$self->{good_response_}/ );
  313. }
  314.  
  315. # ---------------------------------------------------------------------------------------------
  316. #
  317. # configure_item
  318. #
  319. #    $name            Name of this item
  320. #    $templ           The loaded template that was passed as a parameter
  321. #                     when registering
  322. #    $language        Current language
  323. #
  324. # ---------------------------------------------------------------------------------------------
  325.  
  326. sub configure_item
  327. {
  328.     my ( $self, $name, $templ, $language ) = @_;
  329.  
  330.     if ( $name eq 'smtp_fork_and_port' ) {
  331.         $templ->param( 'smtp_port' => $self->config_( 'port' ) );
  332.         $templ->param( 'smtp_force_fork_on' => $self->config_( 'force_fork' ) );
  333.     }
  334.  
  335.     if ( $name eq 'smtp_local' ) {
  336.         $templ->param( 'smtp_local_on' => $self->config_( 'local' ) );
  337.      }
  338.  
  339.     if ( $name eq 'smtp_server' ) {
  340.         $templ->param( 'smtp_chain_server' => $self->config_( 'chain_server' ) );
  341.     }
  342.  
  343.     if ( $name eq 'smtp_server_port' ) {
  344.         $templ->param( 'smtp_chain_port' => $self->config_( 'chain_port' ) );
  345.     }
  346.  
  347.  
  348.     #$self->SUPER::configure_item( $name, $templ, $language );
  349. }
  350.  
  351. # ---------------------------------------------------------------------------------------------
  352. #
  353. # validate_item
  354. #
  355. #    $name            The name of the item being configured, was passed in by the call
  356. #                     to register_configuration_item
  357. #    $templ           The loaded template
  358. #    $language        The language currently in use
  359. #    $form            Hash containing all form items
  360. #
  361. # ---------------------------------------------------------------------------------------------
  362.  
  363. sub validate_item
  364. {
  365.     my ( $self, $name, $templ, $language, $form ) = @_;
  366.  
  367.     if ( $name eq 'smtp_fork_and_port' ) {
  368.  
  369.         if ( defined($$form{smtp_force_fork}) ) {
  370.             $self->config_( 'force_fork', $$form{smtp_force_fork} );
  371.         }
  372.  
  373.         if ( defined($$form{smtp_port}) ) {
  374.             if ( ( $$form{smtp_port} >= 1 ) && ( $$form{smtp_port} < 65536 ) ) {
  375.                 $self->config_( 'port', $$form{smtp_port} );
  376.                 $templ->param( 'smtp_port_feedback' => sprintf( $$language{Configuration_SMTPUpdate}, $self->config_( 'port' ) ) );
  377.              } else {
  378.                 $templ->param( 'smtp_port_feedback' => "<div class=\"error01\">$$language{Configuration_Error3}</div>" );
  379.              }
  380.         }
  381.     }
  382.  
  383.     if ( $name eq 'smtp_local' ) {
  384.         if ( defined $$form{smtp_local} ) {
  385.             $self->config_( 'local', $$form{smtp_local} );
  386.         }
  387.     }
  388.  
  389.     if ( $name eq 'smtp_server' ) {
  390.         if ( defined $$form{smtp_chain_server} ) {
  391.             $self->config_( 'chain_server', $$form{smtp_chain_server} );
  392.             $templ->param( 'smtp_server_feedback' => sprintf $$language{Security_SMTPServerUpdate}, $self->config_( 'chain_server' ) ) ;
  393.         }
  394.     }
  395.  
  396.     if ( $name eq 'smtp_server_port' ) {
  397.         if ( defined $$form{smtp_chain_server_port} ) {
  398.  
  399.             if ( ( $$form{smtp_chain_server_port} >= 1 ) && ( $$form{smtp_chain_server_port} < 65536 ) ) {
  400.                 $self->config_( 'chain_port', $$form{smtp_chain_server_port} );
  401.                 $templ->param( 'smtp_port_feedback' => sprintf $$language{Security_SMTPPortUpdate}, $self->config_( 'chain_port' ) );
  402.             }
  403.             else {
  404.                 $templ->param( 'smtp_port_feedback' => "<div class=\"error01\">$$language{Security_Error1}</div>" );
  405.             }
  406.         }
  407.     }
  408.  
  409.  
  410.     #$self->SUPER::validate_item( $name, $templ, $language, $form );
  411. }
  412.  
  413. 1;
  414.  
  415.  
  416.